home *** CD-ROM | disk | FTP | other *** search
/ Acorn RISC PD-CD 1 / Acorn RISC PD-CD 1.iso / languages / _tile / f83 / bitfields next >
Encoding:
Text File  |  1991-08-15  |  2.4 KB  |  107 lines
  1. \
  2. \  BIT FIELD DEFINITIONS
  3. \
  4. \  Copyright (C) 1988-1990 by Mikael R.K. Patel
  5. \
  6. \  Computer Aided Design Laboratory (CADLAB)
  7. \  Department of Computer and Information Science
  8. \  Linkoping University
  9. \  S-581 83 LINKOPING
  10. \  SWEDEN
  11. \
  12. \  Email: mip@ida.liu.se
  13. \
  14. \  Started on: 30 June 1988
  15. \
  16. \  Last updated on: 25 July 1990
  17. \
  18. \  Dependencies:
  19. \       (forth) forth
  20. \
  21. \  Description:
  22. \       Forth level definitions for bit field manipulation. Bit fields are
  23. \       extracted and altered on the top of stack element. Additional
  24. \       functions for bit and field access are also provided.
  25. \
  26. \  Copying:
  27. \       This program is free software; you can redistribute it and\or modify
  28. \       it under the terms of the GNU General Public License as published by
  29. \       the Free Software Foundation; either version 1, or (at your option)
  30. \       any later version.
  31. \
  32. \       This program is distributed in the hope that it will be useful,
  33. \       but WITHOUT ANY WARRANTY; without even the implied warranty of
  34. \       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  35. \       GNU General Public License for more details.
  36. \
  37. \       You should have received a copy of the GNU General Public License
  38. \       along with this program; see the file COPYING.  If not, write to
  39. \       the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
  40.  
  41. #ifundef b@  ( Check if bit and field access are not supported by the kernel)
  42.  
  43. : b@ ( x pos -- bool)
  44.   1 swap << and boolean
  45. ;
  46.  
  47. : b! ( x y pos -- z)
  48.   >r 1 tuck
  49.   r@ << not and
  50.   swap rot and
  51.   r> << or
  52. ;  
  53.  
  54. : f@ ( x pos width -- y)
  55.   >r >> -1 r> << not and
  56. ;
  57.  
  58. : <f@ ( x pos width -- y)
  59.   >r >> -1 r@ << not and
  60.   dup 1 r@ 1- << and
  61.   if -1 r> << or
  62.   else r> drop then
  63. ;
  64.  
  65. : f! ( x y pos width -- z)
  66.   swap >r -1 swap << not tuck
  67.   r@ << not and
  68.   swap rot and
  69.   r> << or
  70. ;
  71.  
  72. #then
  73.  
  74. vocabulary bitfields ( -- )
  75.  
  76. bitfields definitions
  77.  
  78. : bitfield.type ( -- bitfield.type pos0)
  79.   create here 0 , 0 
  80. does> ( bitfield.type -- )
  81.   drop variable
  82. ;
  83.  
  84. : bits ( pos1 width -- pos2)
  85.   create dup , over , +
  86. does> ( bits -- pos width)
  87.   2@
  88. ;
  89.  
  90. : bitfield.field ( width -- )
  91.   create ,
  92. does> ( bitfield.field -- )
  93.   @ bits
  94. ; private
  95.     
  96. ( Initial set of bit field names)
  97. 1  bitfield.field bit ( -- )
  98. 4  bitfield.field nibble ( -- )
  99. 8  bitfield.field byte ( -- )
  100. 16 bitfield.field word ( -- )
  101.  
  102. : bitfield.end ( bitfield.type pos3 -- )
  103.   last rot ! 32 > abort" bitfield.end: warning too many fields"
  104. ;
  105.  
  106. forth only
  107.